home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sheriffa / frmabout.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-07-10  |  8.3 KB  |  178 lines

  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About SlsDemoVB"
  5.    ClientHeight    =   1380
  6.    ClientLeft      =   36
  7.    ClientTop       =   264
  8.    ClientWidth     =   5676
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   1380
  14.    ScaleWidth      =   5676
  15.    ShowInTaskbar   =   0   'False
  16.    StartUpPosition =   1  'CenterOwner
  17.    Tag             =   "About SlsDemoVB"
  18.    Begin VB.PictureBox picIcon 
  19.       AutoSize        =   -1  'True
  20.       BackColor       =   &H00C0C0C0&
  21.       ClipControls    =   0   'False
  22.       Height          =   432
  23.       Left            =   240
  24.       Picture         =   "frmAbout.frx":0000
  25.       ScaleHeight     =   374.634
  26.       ScaleMode       =   0  'User
  27.       ScaleWidth      =   374.634
  28.       TabIndex        =   2
  29.       TabStop         =   0   'False
  30.       Top             =   240
  31.       Width           =   432
  32.    End
  33.    Begin VB.CommandButton cmdOK 
  34.       Cancel          =   -1  'True
  35.       Caption         =   "OK"
  36.       Default         =   -1  'True
  37.       Height          =   345
  38.       Left            =   4200
  39.       TabIndex        =   0
  40.       Tag             =   "OK"
  41.       Top             =   240
  42.       Width           =   1260
  43.    End
  44.    Begin VB.CommandButton cmdSysInfo 
  45.       Caption         =   "&System Info..."
  46.       Height          =   345
  47.       Left            =   4200
  48.       TabIndex        =   1
  49.       Tag             =   "&System Info..."
  50.       Top             =   720
  51.       Width           =   1245
  52.    End
  53.    Begin VB.Label lblTitle 
  54.       Caption         =   "Sheriff Demo, Version 1.0"
  55.       ForeColor       =   &H00000000&
  56.       Height          =   240
  57.       Left            =   1056
  58.       TabIndex        =   4
  59.       Tag             =   "Application Title"
  60.       Top             =   240
  61.       Width           =   2796
  62.    End
  63.    Begin VB.Label lblVersion 
  64.       Caption         =   "Copyright (c) 1998, Acudata Limited"
  65.       Height          =   228
  66.       Left            =   1056
  67.       TabIndex        =   3
  68.       Tag             =   "Version"
  69.       Top             =   780
  70.       Width           =   2796
  71.    End
  72. Attribute VB_Name = "frmAbout"
  73. Attribute VB_GlobalNameSpace = False
  74. Attribute VB_Creatable = False
  75. Attribute VB_PredeclaredId = True
  76. Attribute VB_Exposed = False
  77. ' Reg Key Security Options...
  78. Const KEY_ALL_ACCESS = &H2003F
  79.                                           
  80. ' Reg Key ROOT Types...
  81. Const HKEY_LOCAL_MACHINE = &H80000002
  82. Const ERROR_SUCCESS = 0
  83. Const REG_SZ = 1                         ' Unicode nul terminated string
  84. Const REG_DWORD = 4                      ' 32-bit number
  85. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  86. Const gREGVALSYSINFOLOC = "MSINFO"
  87. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  88. Const gREGVALSYSINFO = "PATH"
  89. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  90. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  91. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  92. Private Sub cmdSysInfo_Click()
  93.         Call StartSysInfo
  94. End Sub
  95. Private Sub cmdOK_Click()
  96.         Unload Me
  97. End Sub
  98. Public Sub StartSysInfo()
  99.     On Error GoTo SysInfoErr
  100.         Dim rc As Long
  101.         Dim SysInfoPath As String
  102.         
  103.         ' Try To Get System Info Program Path\Name From Registry...
  104.         If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  105.         ' Try To Get System Info Program Path Only From Registry...
  106.         ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  107.                 ' Validate Existance Of Known 32 Bit File Version
  108.                 If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  109.                         SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  110.                         
  111.                 ' Error - File Can Not Be Found...
  112.                 Else
  113.                         GoTo SysInfoErr
  114.                 End If
  115.         ' Error - Registry Entry Can Not Be Found...
  116.         Else
  117.                 GoTo SysInfoErr
  118.         End If
  119.         
  120.         Call Shell(SysInfoPath, vbNormalFocus)
  121.         
  122.         Exit Sub
  123. SysInfoErr:
  124.         MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  125. End Sub
  126. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  127.         Dim i As Long                                           ' Loop Counter
  128.         Dim rc As Long                                          ' Return Code
  129.         Dim hKey As Long                                        ' Handle To An Open Registry Key
  130.         Dim hDepth As Long                                      '
  131.         Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  132.         Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  133.         Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  134.         '------------------------------------------------------------
  135.         ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  136.         '------------------------------------------------------------
  137.         rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  138.         
  139.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  140.         
  141.         tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  142.         KeyValSize = 1024                                       ' Mark Variable Size
  143.         
  144.         '------------------------------------------------------------
  145.         ' Retrieve Registry Key Value...
  146.         '------------------------------------------------------------
  147.         rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  148.                                                 
  149.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  150.         
  151.         If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  152.                 tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  153.         Else                                                    ' WinNT Does NOT Null Terminate String...
  154.                 tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  155.         End If
  156.         '------------------------------------------------------------
  157.         ' Determine Key Value Type For Conversion...
  158.         '------------------------------------------------------------
  159.         Select Case KeyValType                                  ' Search Data Types...
  160.         Case REG_SZ                                             ' String Registry Key Data Type
  161.                 KeyVal = tmpVal                                     ' Copy String Value
  162.         Case REG_DWORD                                          ' Double Word Registry Key Data Type
  163.                 For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  164.                         KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  165.                 Next
  166.                 KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  167.         End Select
  168.         
  169.         GetKeyValue = True                                      ' Return Success
  170.         rc = RegCloseKey(hKey)                                  ' Close Registry Key
  171.         Exit Function                                           ' Exit
  172.         
  173. GetKeyError:    ' Cleanup After An Error Has Occured...
  174.         KeyVal = ""                                             ' Set Return Val To Empty String
  175.         GetKeyValue = False                                     ' Return Failure
  176.         rc = RegCloseKey(hKey)                                  ' Close Registry Key
  177. End Function
  178.